{-
    pHaskell Translator v0.1 
    Copyright (C) 2009  Ruben Marcelo Caro 

    This program is free software: you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation, either version 3 of the License, or
    (at your option) any later version.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this program.  If not, see <http://www.gnu.org/licenses/>.
-}
module Fase1 where
import PHaskellParser 
import PHaskellTypes
import LambdaTypes
import LambdaLifting

{-
Extrae el contexto a partir de los TypeSuperCombinator
 
builtInitialHaskellContext:: haskellProgram->context
haskellProgram : Haskell Program
context        : Type context [(String, HaskellType)] 
-}
builtInitialHaskellContext:: Program->[TypeDefinition]
builtInitialHaskellContext cs = map getType haskellTypes
									where
										haskellTypes  = filter isTypeDefinition cs
										getType (TypeDefinitionSc typeInfo) = typeInfo
										getType sc    = error ("Invalid type super convinator"++ show sc)

{-
lookupContext::name->context->haskellType
 name         : name to lookup 
 context      : Type context (String, HaskellType)
 haskellType  : Type of the variable
-}
lookupContext::String->[TypeDefinition]->HaskellType
lookupContext name context = case lookup name context of 
								Just lambdaType -> lambdaType
								Nothing         -> Unknown

--[(String, [LConstructorType])]
buildUserDefinedTypesConstructors::Program->LUserDefinedTypes
buildUserDefinedTypesConstructors program  = map  haskellTypeDefinition2lambdaTypeDefinition typesConstructor
								  			where
												typesConstructor = filter isUserTypeDefinition program
												haskellTypeDefinition2lambdaTypeDefinition (UserTypeDefinition name ctos) =  (name , (map haskellToLambdaTypeConstructor ctos))
												haskellToLambdaTypeConstructor (ConstructorType ctorName types) = LConstructorType ctorName (map haskellToLambdaType types)  
{-
Esta funcion es el punto de entrada en la convercion de phaskell a calcula lambda
Convierte cada super combinator de la lista a un LDefinition

phaskell2Lambda::phaskellProgram->typeContext->lambdaProgram
 phaskellProgram  : P haskell parsed programm  [SuperCombinator]
 typeContext      : type information of each variable (String, HaskellType)
 lambdaProgram    : Lambda program [LDefinition]
-}
phaskell2Lambda::Program->[TypeDefinition]->LProgram
phaskell2Lambda haskelSupedCom  typeContext = map (superCombinator2Ldefinition typeContext) haskellProgram
												where
													haskellProgram = filter isFunctionDefinition haskelSupedCom
 

{-
Convierte cada super convinator en una lambda definition, da error si 
el superconvinator no es una definicion de funcion (ej definiciond e tipo)

superCombinator2Ldefinition::typeContext->superCombinator->lambdaDefinition
 typeContext      : type information of each variable (String, HaskellType)
 superCombinator  : Haskell super-combinator 
 lambdaDefinition : Lambda Definition
 
 nota: FunctionDefinitionSc String [Exp] Exp Program 
 
 
-}
superCombinator2Ldefinition::[TypeDefinition]->SuperCombinator->LDefinition
superCombinator2Ldefinition context (FunctionDefinitionSc funcName params e locals) = LDefinition funcName e' localsDef
 																						where
																							e'            = buildLambdaFromHaskellDefinition params e funcType localsContext
						 																	funcType      = lookupContext funcName context
						 																	localsContext = context++(builtInitialHaskellContext locals)
																							localsDef     = phaskell2Lambda locals localsContext
																							

superCombinator2Ldefinition context  sc = error ("Invalid super convinator while tranlate phaskell program to lambda program: " ++ show sc)


{-
Construye la lambda exprecion a partir de los parametros, la exprecion final
el tipo de la exprecion (pej t->t'->t''), tomando t como tipo del primet parametro
t' como tipo del segundo, etc
 
buildLambdaFromHaskellDefinition::parametros->exprecion->tipoDeLaLambda->contexto->lambdaExp
Sea:	 
	 f::t->t'->t''->te
	 f a b c = 1
 
 parametros     : a b c
 exprecion      : Integer "1"
 tipoDeLaLambda : t->t'->t''->te
 contexto       : Type context
 lambdaExp      : LLambda a t (LLambda b t' (LLambda c t'' (LInteger "1")))
-}
buildLambdaFromHaskellDefinition::[Exp]->Exp->HaskellType->[TypeDefinition]->LExp																																			
buildLambdaFromHaskellDefinition (p:ps) e funcType  context   = (LLambda p' (actualLambdaType) e')
																	where
																		actualHaskelType = sourceType funcType
																		actualLambdaType = haskellToLambdaType actualHaskelType
																		nextHaskellTypes = destinationType funcType
																		e'               = buildLambdaFromHaskellDefinition ps e nextHaskellTypes  context
																		p'               = buildLExpresion context p

buildLambdaFromHaskellDefinition    _   e funcType  context   = buildLExpresion context e 
																		 

{-
Construye una expresion lambda de una espresion haskell
-}
buildLExpresion::[TypeDefinition]->Exp->LExp
buildLExpresion context (App e1 e2)            = LApp (buildLExpresion context e1 ) (buildLExpresion context e2 )
buildLExpresion context (Integer number)       = LInteger number 
buildLExpresion context (Variable var)         = LVariable var
buildLExpresion context (Boolean bool)         = LBoolean bool
buildLExpresion context (If e e' e'')          = LIf (buildLExpresion context e ) (buildLExpresion context e' ) (buildLExpresion context e'' )
buildLExpresion context (IfOnly e e')          = LIfOnly (buildLExpresion context e ) (buildLExpresion context e' )    
buildLExpresion context (Lambda e1 vtype e)    = LLambda (buildLExpresion context e1 ) (haskellToLambdaType vtype) (buildLExpresion context e ) 

{-
Transforma los tipos de phaskell a tipos de lambda calculo
-}
haskellToLambdaType::HaskellType->LambdaType
haskellToLambdaType Bool          = LtBool
haskellToLambdaType Int           = LtInt
haskellToLambdaType (Arrow t1 t2) = LtArrow (haskellToLambdaType t1) (haskellToLambdaType t2)
haskellToLambdaType (UserDef name)= LUserDef name
haskellToLambdaType Unknown       = LtUnknown

{- Convierte las applicaciones que son Type Constructor a LTypeConstructor -}
lambdaUserDefinedTyped::LUserDefinedTypes->LDefinition->LDefinition
lambdaUserDefinedTyped ts (LDefinition name lexp locals) = (LDefinition name lexp' locals')
															where
																lexp'   = lambdaUserDefinedTypedExp ts lexp
																locals' = map (lambdaUserDefinedTyped ts) locals

lambdaUserDefinedTypedExp::LUserDefinedTypes->LExp->LExp
lambdaUserDefinedTypedExp ts app@(LApp e e') = case isTypeConstructorExp ts app of 
												False ->  LApp (lambdaUserDefinedTypedExp ts e) (lambdaUserDefinedTypedExp ts e')
												True  ->  expresioListToTypeConstructor ts expresionList
													where
														expresionList = getTypeConstructorAllParameter app
lambdaUserDefinedTypedExp ts var@(LVariable name) =  case isTypeConstructorExp ts var of 
														False -> var
														True  -> expresioListToTypeConstructor ts [var]													
   
   
lambdaUserDefinedTypedExp ts (LLambda e lt e')  = LLambda (lambdaUserDefinedTypedExp ts e) lt (lambdaUserDefinedTypedExp ts e')
lambdaUserDefinedTypedExp ts (LIf     e e' e'') = LIf (lambdaUserDefinedTypedExp ts e) (lambdaUserDefinedTypedExp ts e') (lambdaUserDefinedTypedExp ts e'')
lambdaUserDefinedTypedExp ts (LIfOnly e' e'')   = LIfOnly (lambdaUserDefinedTypedExp ts e') (lambdaUserDefinedTypedExp ts e'')     
lambdaUserDefinedTypedExp ts lexp             = lexp


getTypeConstructorAllParameter::LExp->[LExp]
getTypeConstructorAllParameter (LApp e e') = (getTypeConstructorAllParameter e)++[e'] 
getTypeConstructorAllParameter e = [e]


expresioListToTypeConstructor::LUserDefinedTypes->[LExp]->LExp
expresioListToTypeConstructor ts ((LVariable typename):xs) = LTypeConstructor typename (map (lambdaUserDefinedTypedExp ts) xs) 
expresioListToTypeConstructor ts lexp = error (show lexp)


isTypeConstructorExp::LUserDefinedTypes->LExp->Bool
isTypeConstructorExp cs (LApp e e')     = isTypeConstructorExp cs e
isTypeConstructorExp cs (LVariable var) = elem var names 
											where
												names = getAllConstructorsName cs
isTypeConstructorExp cs _               = False




splitPHaskellFromGeneratrix'::(Program, GeneratrixProgram)->Program->(Program, GeneratrixProgram)
splitPHaskellFromGeneratrix' (a,b) []  = (a,b)
splitPHaskellFromGeneratrix' (a,b) ((GeneratrixTunneling g ):xs)  = splitPHaskellFromGeneratrix' (a, b++[g]) xs 
splitPHaskellFromGeneratrix' (a,b) (x:xs)  = splitPHaskellFromGeneratrix'  (a++[x], b) xs   

splitPHaskellFromGeneratrix::Program->(Program, GeneratrixProgram)
splitPHaskellFromGeneratrix = splitPHaskellFromGeneratrix' ([],[])

-- Funcion principal
makeFase1::String->(LProgram, LUserDefinedTypes)
makeFase1 phaskellProgram = (map lambdaUserDefinedTypedTransformer lambdaProgramLifted, userDefinedTypes)                          							
							where
								errorsdf         = error (show (parsedHaskell))
								parsedHaskell    = (parser.lexer) (phaskellProgram)
								initialContext   = builtInitialHaskellContext parsedHaskell
								parsedHaskellWithoutGeneratrix =filter isSuperCombinator parsedHaskell
								lambdaProgram    = phaskell2Lambda  parsedHaskellWithoutGeneratrix initialContext
								lambdaProgramLifted = map lambdaLifting lambdaProgram
								lambdaUserDefinedTypedTransformer = lambdaUserDefinedTyped userDefinedTypes
								userDefinedTypes = buildUserDefinedTypesConstructors parsedHaskell
								
								